#' Stack multiple grobs

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Stack grobs as a new grob with 1 column and multiple rows layout.

#'

#' @param ... grobs.

#' @param grobs (`list` of `grob`)\cr a list of grobs.

#' @param padding (`grid::unit`)\cr unit of length 1, space between each grob.

#' @param vp (`viewport` or `NULL`)\cr a [viewport()] object (or `NULL`).

#' @param name (`string`)\cr a character identifier for the grob.

#' @param gp (`gpar`)\cr a [gpar()] object.

#'

#' @return A `grob`.

#'

#' @examples

#' library(grid)

#'

#' g1 <- circleGrob(gp = gpar(col = "blue"))

#' g2 <- circleGrob(gp = gpar(col = "red"))

#' g3 <- textGrob("TEST TEXT")

#' grid.newpage()

#' grid.draw(stack_grobs(g1, g2, g3))

#'

#' showViewport()

#'

#' grid.newpage()

#' pushViewport(viewport(layout = grid.layout(1, 2)))

#' vp1 <- viewport(layout.pos.row = 1, layout.pos.col = 2)

#' grid.draw(stack_grobs(g1, g2, g3, vp = vp1, name = "test"))

#'

#' showViewport()

#' grid.ls(grobs = TRUE, viewports = TRUE, print = FALSE)

#'

#' @export

stack_grobs <- function(...,

                        grobs = list(...),

                        padding = grid::unit(2, "line"),

                        vp = NULL,

                        gp = NULL,

                        name = NULL) {

  )

  )

  }

      } else {

      }

    }

  )

  )

    )

  )

  )

}

#' Arrange multiple grobs

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Arrange grobs as a new grob with `n * m (rows * cols)` layout.

#'

#' @inheritParams stack_grobs

#' @param ncol (`integer(1)`)\cr number of columns in layout.

#' @param nrow (`integer(1)`)\cr number of rows in layout.

#' @param padding_ht (`grid::unit`)\cr unit of length 1, vertical space between each grob.

#' @param padding_wt (`grid::unit`)\cr unit of length 1, horizontal space between each grob.

#'

#' @return A `grob`.

#'

#' @examples

#' library(grid)

#'

#' \donttest{

#' num <- lapply(1:9, textGrob)

#' grid::grid.newpage()

#' grid.draw(arrange_grobs(grobs = num, ncol = 2))

#'

#' showViewport()

#'

#' g1 <- circleGrob(gp = gpar(col = "blue"))

#' g2 <- circleGrob(gp = gpar(col = "red"))

#' g3 <- textGrob("TEST TEXT")

#' grid::grid.newpage()

#' grid.draw(arrange_grobs(g1, g2, g3, nrow = 2))

#'

#' showViewport()

#'

#' grid::grid.newpage()

#' grid.draw(arrange_grobs(g1, g2, g3, ncol = 3))

#'

#' grid::grid.newpage()

#' grid::pushViewport(grid::viewport(layout = grid::grid.layout(1, 2)))

#' vp1 <- grid::viewport(layout.pos.row = 1, layout.pos.col = 2)

#' grid.draw(arrange_grobs(g1, g2, g3, ncol = 2, vp = vp1))

#'

#' showViewport()

#' }

#' @export

arrange_grobs <- function(...,

                          grobs = list(...),

                          ncol = NULL, nrow = NULL,

                          padding_ht = grid::unit(2, "line"),

                          padding_wt = grid::unit(2, "line"),

                          vp = NULL,

                          gp = NULL,

                          name = NULL) {

  )

  )

  }

  }

  }

  }

      } else {

      }

    }

  )

      } else {

      }

    }

  )

  )

          ))

        )

      }

    }

  }

  )

  )

}

#' Draw `grob`

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Draw grob on device page.

#'

#' @param grob (`grob`)\cr grid object.

#' @param newpage (`flag`)\cr draw on a new page.

#' @param vp (`viewport` or `NULL`)\cr a [viewport()] object (or `NULL`).

#'

#' @return A `grob`.

#'

#' @examples

#' library(dplyr)

#' library(grid)

#'

#' \donttest{

#' rect <- rectGrob(width = grid::unit(0.5, "npc"), height = grid::unit(0.5, "npc"))

#' rect %>% draw_grob(vp = grid::viewport(angle = 45))

#'

#' num <- lapply(1:10, textGrob)

#' num %>%

#'   arrange_grobs(grobs = .) %>%

#'   draw_grob()

#' showViewport()

#' }

#'

#' @export

draw_grob <- function(grob, newpage = TRUE, vp = NULL) {

  )

  }

  }

}

tern_grob <- function(x) {

}

#' @keywords internal

print.ternGrob <- function(x, ...) {

}

#' Tabulate biomarker effects on survival by subgroup

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Tabulate the estimated effects of multiple continuous biomarker variables

#' across population subgroups.

#'

#' @inheritParams fit_coxreg_multivar

#' @inheritParams survival_duration_subgroups

#' @inheritParams argument_convention

#' @param df (`data.frame`)\cr containing all analysis variables, as returned by

#'   [extract_survival_biomarkers()].

#' @param vars (`character`)\cr the names of statistics to be reported among:

#'   * `n_tot_events`: Total number of events per group.

#'   * `n_tot`: Total number of observations per group.

#'   * `median`: Median survival time.

#'   * `hr`: Hazard ratio.

#'   * `ci`: Confidence interval of hazard ratio.

#'   * `pval`: p-value of the effect.

#'   Note, one of the statistics `n_tot` and `n_tot_events`, as well as both `hr` and `ci` are required.

#'

#' @details These functions create a layout starting from a data frame which contains

#'   the required statistics. The tables are then typically used as input for forest plots.

#'

#' @examples

#' library(dplyr)

#'

#' adtte <- tern_ex_adtte

#'

#' # Save variable labels before data processing steps.

#' adtte_labels <- formatters::var_labels(adtte)

#'

#' adtte_f <- adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   mutate(

#'     AVALU = as.character(AVALU),

#'     is_event = CNSR == 0

#'   )

#' labels <- c("AVALU" = adtte_labels[["AVALU"]], "is_event" = "Event Flag")

#' formatters::var_labels(adtte_f)[names(labels)] <- labels

#'

#' # Typical analysis of two continuous biomarkers `BMRKR1` and `AGE`,

#' # in multiple regression models containing one covariate `RACE`,

#' # as well as one stratification variable `STRATA1`. The subgroups

#' # are defined by the levels of `BMRKR2`.

#'

#' df <- extract_survival_biomarkers(

#'   variables = list(

#'     tte = "AVAL",

#'     is_event = "is_event",

#'     biomarkers = c("BMRKR1", "AGE"),

#'     strata = "STRATA1",

#'     covariates = "SEX",

#'     subgroups = "BMRKR2"

#'   ),

#'   label_all = "Total Patients",

#'   data = adtte_f

#' )

#' df

#'

#' # Here we group the levels of `BMRKR2` manually.

#' df_grouped <- extract_survival_biomarkers(

#'   variables = list(

#'     tte = "AVAL",

#'     is_event = "is_event",

#'     biomarkers = c("BMRKR1", "AGE"),

#'     strata = "STRATA1",

#'     covariates = "SEX",

#'     subgroups = "BMRKR2"

#'   ),

#'   data = adtte_f,

#'   groups_lists = list(

#'     BMRKR2 = list(

#'       "low" = "LOW",

#'       "low/medium" = c("LOW", "MEDIUM"),

#'       "low/medium/high" = c("LOW", "MEDIUM", "HIGH")

#'     )

#'   )

#' )

#' df_grouped

#'

#' @name survival_biomarkers_subgroups

#' @order 1

NULL

#' Prepare survival data estimates for multiple biomarkers in a single data frame

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Prepares estimates for number of events, patients and median survival times, as well as hazard ratio estimates,

#' confidence intervals and p-values, for multiple biomarkers across population subgroups in a single data frame.

#' `variables` corresponds to the names of variables found in `data`, passed as a named `list` and requires elements

#' `tte`, `is_event`, `biomarkers` (vector of continuous biomarker variables), and optionally `subgroups` and `strata`.

#' `groups_lists` optionally specifies groupings for `subgroups` variables.

#'

#' @inheritParams argument_convention

#' @inheritParams fit_coxreg_multivar

#' @inheritParams survival_duration_subgroups

#'

#' @return A `data.frame` with columns `biomarker`, `biomarker_label`, `n_tot`, `n_tot_events`,

#'   `median`, `hr`, `lcl`, `ucl`, `conf_level`, `pval`, `pval_label`, `subgroup`, `var`,

#'   `var_label`, and `row_type`.

#'

#' @seealso [h_coxreg_mult_cont_df()] which is used internally, [tabulate_survival_biomarkers()].

#'

#' @export

extract_survival_biomarkers <- function(variables,

                                        data,

                                        groups_lists = list(),

                                        control = control_coxreg(),

                                        label_all = "All Patients") {

    )

  }

  # Start with all patients.

  )

    # Only return result for all patients.

  } else {

    # Add subgroups results.

    )

      )

    })

    )

  }

}

#' @describeIn survival_biomarkers_subgroups Table-creating function which creates a table

#'   summarizing biomarker effects on survival by subgroup.

#'

#' @param label_all `r lifecycle::badge("deprecated")`\cr please assign the `label_all` parameter within the

#'   [extract_survival_biomarkers()] function when creating `df`.

#'

#' @return An `rtables` table summarizing biomarker effects on survival by subgroup.

#'

#' @note In contrast to [tabulate_survival_subgroups()] this tabulation function does

#'   not start from an input layout `lyt`. This is because internally the table is

#'   created by combining multiple subtables.

#'

#' @seealso [h_tab_surv_one_biomarker()] which is used internally, [extract_survival_biomarkers()].

#'

#' @examples

#' ## Table with default columns.

#' tabulate_survival_biomarkers(df)

#'

#' ## Table with a manually chosen set of columns: leave out "pval", reorder.

#' tab <- tabulate_survival_biomarkers(

#'   df = df,

#'   vars = c("n_tot_events", "ci", "n_tot", "median", "hr"),

#'   time_unit = as.character(adtte_f$AVALU[1])

#' )

#'

#' ## Finally produce the forest plot.

#' \donttest{

#' g_forest(tab, xlim = c(0.8, 1.2))

#' }

#'

#' @export

#' @order 2

tabulate_survival_biomarkers <- function(df,

                                         vars = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"),

                                         groups_lists = list(),

                                         control = control_coxreg(),

                                         label_all = lifecycle::deprecated(),

                                         time_unit = NULL,

                                         na_str = default_na_str(),

                                         .indent_mods = 0L) {

      )

    )

  }

    )

    # Insert label row as first row in table.

  })

  )

}

#' Univariate formula special term

#'

#' @description `r lifecycle::badge("stable")`

#'

#' The special term `univariate` indicate that the model should be fitted individually for

#' every variable included in univariate.

#'

#' @param x (`character`)\cr a vector of variable names separated by commas.

#'

#' @return When used within a model formula, produces univariate models for each variable provided.

#'

#' @details

#' If provided alongside with pairwise specification, the model

#' `y ~ ARM + univariate(SEX, AGE, RACE)` lead to the study and comparison of the models

#' + `y ~ ARM`

#' + `y ~ ARM + SEX`

#' + `y ~ ARM + AGE`

#' + `y ~ ARM + RACE`

#'

#' @export

univariate <- function(x) {

}

# Get the right-hand-term of a formula

rht <- function(x) {

}

#' Hazard ratio estimation in interactions

#'

#' This function estimates the hazard ratios between arms when an interaction variable is given with

#' specific values.

#'

#' @param variable,given (`character(2)`)\cr names of the two variables in the interaction. We seek the estimation of

#'   the levels of `variable` given the levels of `given`.

#' @param lvl_var,lvl_given (`character`)\cr corresponding levels given by [levels()].

#' @param mmat (named `numeric`) a vector filled with `0`s used as a template to obtain the design matrix.

#' @param coef (`numeric`)\cr vector of estimated coefficients.

#' @param vcov (`matrix`)\cr variance-covariance matrix of underlying model.

#' @param conf_level (`proportion`)\cr confidence level of estimate intervals.

#'

#' @details Given the cox regression investigating the effect of Arm (A, B, C; reference A)

#'   and Sex (F, M; reference Female). The model is abbreviated: y ~ Arm + Sex + Arm x Sex.

#'   The cox regression estimates the coefficients along with a variance-covariance matrix for:

#'

#'   - b1 (arm b), b2 (arm c)

#'   - b3 (sex m)

#'   - b4 (arm b: sex m), b5 (arm c: sex m)

#'

#'   Given that I want an estimation of the Hazard Ratio for arm C/sex M, the estimation

#'   will be given in reference to arm A/Sex M by exp(b2 + b3 + b5)/ exp(b3) = exp(b2 + b5),

#'   therefore the interaction coefficient is given by b2 + b5 while the standard error is obtained

#'   as $1.96 * sqrt(Var b2 + Var b5 + 2 * covariance (b2,b5))$ for a confidence level of 0.95.

#'

#' @return A list of matrices (one per level of variable) with rows corresponding to the combinations of

#'   `variable` and `given`, with columns:

#'   * `coef_hat`: Estimation of the coefficient.

#'   * `coef_se`: Standard error of the estimation.

#'   * `hr`: Hazard ratio.

#'   * `lcl, ucl`: Lower/upper confidence limit of the hazard ratio.

#'

#' @seealso [s_cox_multivariate()].

#'

#' @examples

#' library(dplyr)

#' library(survival)

#'

#' ADSL <- tern_ex_adsl %>%

#'   filter(SEX %in% c("F", "M"))

#'

#' adtte <- tern_ex_adtte %>% filter(PARAMCD == "PFS")

#' adtte$ARMCD <- droplevels(adtte$ARMCD)

#' adtte$SEX <- droplevels(adtte$SEX)

#'

#' mod <- coxph(

#'   formula = Surv(time = AVAL, event = 1 - CNSR) ~ (SEX + ARMCD)^2,

#'   data = adtte

#' )

#'

#' mmat <- stats::model.matrix(mod)[1, ]

#' mmat[!mmat == 0] <- 0

#'

#' @keywords internal

estimate_coef <- function(variable, given,

                          lvl_var, lvl_given,

                          coef,

                          mmat,

                          vcov,

                          conf_level = 0.95) {

    }

  )

    }

  )

  })

  })

  )

}

#' `tryCatch` around `car::Anova`

#'

#' Captures warnings when executing [car::Anova].

#'

#' @inheritParams car::Anova

#'

#' @return A list with item `aov` for the result of the model and `error_text` for the captured warnings.

#'

#' @examples

#' # `car::Anova` on cox regression model including strata and expected

#' # a likelihood ratio test triggers a warning as only Wald method is

#' # accepted.

#'

#' library(survival)

#'

#' mod <- coxph(

#'   formula = Surv(time = futime, event = fustat) ~ factor(rx) + strata(ecog.ps),

#'   data = ovarian

#' )

#'

#' @keywords internal

try_car_anova <- function(mod,

                          test.statistic) { # nolint

          ),

        )

      },

        # If a warning is detected it is handled as "w".

        # A warning is sometimes expected, then, we want to restart

        # the execution while ignoring the warning.

      }

    ),

    }

  )

}

#' Fit a Cox regression model and ANOVA

#'

#' The functions derives the effect p-values using [car::Anova()] from [survival::coxph()] results.

#'

#' @inheritParams t_coxreg

#'

#' @return A list with items `mod` (results of [survival::coxph()]), `msum` (result of `summary`) and

#'   `aov` (result of [car::Anova()]).

#'

#' @noRd

fit_n_aov <- function(formula,

                      data = data,

                      conf_level = conf_level,

                      pval_method = c("wald", "likelihood"),

                      ...) {

    # We expect some warnings due to coxph which fails strict programming.

  })

    )

  )

}

# argument_checks

check_formula <- function(formula) {

  }

}

check_covariate_formulas <- function(covariates) {

  }

}

name_covariate_names <- function(covariates) {

}

check_increments <- function(increments, covariates) {

            )

          )

        }

      }

    )

  }

}

#' Multivariate Cox model - summarized results

#'

#' Analyses based on multivariate Cox model are usually not performed for the Controlled Substance Reporting or

#' regulatory documents but serve exploratory purposes only (e.g., for publication). In practice, the model usually

#' includes only the main effects (without interaction terms). It produces the hazard ratio estimates for each of the

#' covariates included in the model.

#' The analysis follows the same principles (e.g., stratified vs. unstratified analysis and tie handling) as the

#' usual Cox model analysis. Since there is usually no pre-specified hypothesis testing for such analysis,

#' the p.values need to be interpreted with caution. (**Statistical Analysis of Clinical Trials Data with R**,

#' `NEST's bookdown`)

#'

#' @param formula (`formula`)\cr a formula corresponding to the investigated [survival::Surv()] survival model

#'   including covariates.

#' @param data (`data.frame`)\cr a data frame which includes the variable in formula and covariates.

#' @param conf_level (`proportion`)\cr the confidence level for the hazard ratio interval estimations. Default is 0.95.

#' @param pval_method (`string`)\cr the method used for the estimation of p-values, should be one of

#'   `"wald"` (default) or `"likelihood"`.

#' @param ... optional parameters passed to [survival::coxph()]. Can include `ties`, a character string specifying the

#'   method for tie handling, one of `exact` (default), `efron`, `breslow`.

#'

#' @return A `list` with elements `mod`, `msum`, `aov`, and `coef_inter`.

#'

#' @details The output is limited to single effect terms. Work in ongoing for estimation of interaction terms

#'   but is out of scope as defined by the  Global Data Standards Repository

#'   (**`GDS_Standard_TLG_Specs_Tables_2.doc`**).

#'

#' @seealso [estimate_coef()].

#'

#' @examples

#' library(dplyr)

#'

#' adtte <- tern_ex_adtte

#' adtte_f <- subset(adtte, PARAMCD == "OS") # _f: filtered

#' adtte_f <- filter(

#'   adtte_f,

#'   PARAMCD == "OS" &

#'     SEX %in% c("F", "M") &

#'     RACE %in% c("ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE")

#' )

#' adtte_f$SEX <- droplevels(adtte_f$SEX)

#' adtte_f$RACE <- droplevels(adtte_f$RACE)

#'

#' @keywords internal

s_cox_multivariate <- function(formula, data,

                               conf_level = 0.95,

                               pval_method = c("wald", "likelihood"),

                               ...) {

      }

    }

  )

  # Results directly exported from environment(fit_n_aov) to environment(s_function_draft)

    ...

  )

      )

    }

      }

    )

  }

}

#' Get default statistical methods and their associated formats, labels, and indent modifiers

#'

#' @description `r lifecycle::badge("experimental")`

#'

#' Utility functions to get valid statistic methods for different method groups

#' (`.stats`) and their associated formats (`.formats`), labels (`.labels`), and indent modifiers

#' (`.indent_mods`). This utility is used across `tern`, but some of its working principles can be

#' seen in [analyze_vars()]. See notes to understand why this is experimental.

#'

#' @param stats (`character`)\cr statistical methods to get defaults for.

#'

#' @details

#' Current choices for `type` are `counts` and `numeric` for [analyze_vars()] and affect `get_stats()`.

#'

#' @note

#' These defaults are experimental because we use the names of functions to retrieve the default

#' statistics. This should be generalized in groups of methods according to more reasonable groupings.

#'

#' @name default_stats_formats_labels

NULL

#' @describeIn default_stats_formats_labels Get statistics available for a given method

#'   group (analyze function).

#'

#' @param method_groups (`character`)\cr indicates the statistical method group (`tern` analyze function)

#'   to retrieve default statistics for. A character vector can be used to specify more than one statistical

#'   method group.

#' @param stats_in (`character`)\cr statistics to retrieve for the selected method group.

#' @param add_pval (`flag`)\cr should `"pval"` (or `"pval_counts"` if `method_groups` contains

#'   `"analyze_vars_counts"`) be added to the statistical methods?

#'

#' @return

#' * `get_stats()` returns a `character` vector of statistical methods.

#'

#' @examples

#' # analyze_vars is numeric

#' num_stats <- get_stats("analyze_vars_numeric") # also the default

#'

#' # Other type

#' cnt_stats <- get_stats("analyze_vars_counts")

#'

#' # Weirdly taking the pval from count_occurrences

#' only_pval <- get_stats("count_occurrences", add_pval = TRUE, stats_in = "pval")

#'

#' # All count_occurrences

#' all_cnt_occ <- get_stats("count_occurrences")

#'

#' # Multiple

#' get_stats(c("count_occurrences", "analyze_vars_counts"))

#'

#' @export

get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, add_pval = FALSE) {

  # Default is still numeric

  }

  # Defaults for loop

  # Loop for multiple method groups

    } else {

    }

  }

  # If you added pval to the stats_in you certainly want it

    # Must be only one value between choices

    # Mismatch with counts and numeric

      )

    }

    # Lets add it even if present (thanks to unique)

  }

  # Mainly used in "analyze_vars" but it could be necessary elsewhere

    } else {

    }

  }

  # Filtering for stats_in (character vector)

  }

  # If intersect did not find matches (and no pval?) -> error

    )

  }

}

#' @describeIn default_stats_formats_labels Get formats corresponding to a list of statistics.

#'

#' @param formats_in (named `vector`)\cr inserted formats to replace defaults. It can be a

#'   character vector from [formatters::list_valid_format_labels()] or a custom format function.

#'

#' @return

#' * `get_formats_from_stats()` returns a named vector of formats (if present in either

#'   `tern_default_formats` or `formats_in`, otherwise `NULL`). Values can be taken from

#'   [formatters::list_valid_format_labels()] or a custom function (e.g. [formatting_functions]).

#'

#' @note Formats in `tern` and `rtables` can be functions that take in the table cell value and

#'   return a string. This is well documented in `vignette("custom_appearance", package = "rtables")`.

#'

#' @examples

#' # Defaults formats

#' get_formats_from_stats(num_stats)

#' get_formats_from_stats(cnt_stats)

#' get_formats_from_stats(only_pval)

#' get_formats_from_stats(all_cnt_occ)

#'

#' # Addition of customs

#' get_formats_from_stats(all_cnt_occ, formats_in = c("fraction" = c("xx")))

#' get_formats_from_stats(all_cnt_occ, formats_in = list("fraction" = c("xx.xx", "xx")))

#'

#' @seealso [formatting_functions]

#'

#' @export

get_formats_from_stats <- function(stats, formats_in = NULL) {

  # It may be a list if there is a function in the formats

    # Or it may be a vector of characters

  } else {

  }

  # Extract global defaults

  # Select only needed formats from stats

  # Modify some with custom formats

    # Stats is the main

  }

}

#' @describeIn default_stats_formats_labels Get labels corresponding to a list of statistics.

#'

#' @param labels_in (named `character`)\cr inserted labels to replace defaults.

#' @param row_nms (`character`)\cr row names. Levels of a `factor` or `character` variable, each

#'   of which the statistics in `.stats` will be calculated for. If this parameter is set, these

#'   variable levels will be used as the defaults, and the names of the given custom values should

#'   correspond to levels (or have format `statistic.level`) instead of statistics. Can also be

#'   variable names if rows correspond to different variables instead of levels. Defaults to `NULL`.

#'

#' @return

#' * `get_labels_from_stats()` returns a named `character` vector of labels (if present in either

#'   `tern_default_labels` or `labels_in`, otherwise `NULL`).

#'

#' @examples

#' # Defaults labels

#' get_labels_from_stats(num_stats)

#' get_labels_from_stats(cnt_stats)

#' get_labels_from_stats(only_pval)

#' get_labels_from_stats(all_cnt_occ)

#'

#' # Addition of customs

#' get_labels_from_stats(all_cnt_occ, labels_in = c("fraction" = "Fraction"))

#' get_labels_from_stats(all_cnt_occ, labels_in = list("fraction" = c("Some more fractions")))

#'

#' @export

get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL) {

  # It may be a list

    # Or it may be a vector of characters

  } else {

  }

    }

  } else {

  }

  # Modify some with custom labels

    # Stats is the main

  }

}

#' @describeIn default_stats_formats_labels Format indent modifiers for a given vector/list of statistics.

#'

#' @param indents_in (named `vector`)\cr inserted indent modifiers to replace defaults (default is `0L`).

#'

#' @return

#' * `get_indents_from_stats()` returns a single indent modifier value to apply to all rows

#'   or a named numeric vector of indent modifiers (if present, otherwise `NULL`).

#'

#' @examples

#' get_indents_from_stats(all_cnt_occ, indents_in = 3L)

#' get_indents_from_stats(all_cnt_occ, indents_in = list(count = 2L, count_fraction = 5L))

#' get_indents_from_stats(

#'   all_cnt_occ,

#'   indents_in = list(a = 2L, count.a = 1L, count.b = 5L), row_nms = c("a", "b")

#' )

#'

#' @export

get_indents_from_stats <- function(stats, indents_in = NULL, row_nms = NULL) {

  # It may be a list

    # Or it may be a vector of integers

  } else {

  }

  }

    }

  } else {

  }

  # Modify some with custom labels

    # Stats is the main

  }

}

#' Update labels according to control specifications

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Given a list of statistic labels and and a list of control parameters, updates labels with a relevant

#' control specification. For example, if control has element `conf_level` set to `0.9`, the default

#' label for statistic `mean_ci` will be updated to `"Mean 90% CI"`. Any labels that are supplied

#' via `labels_custom` will not be updated regardless of `control`.

#'

#' @param labels_default (named `character`)\cr a named vector of statistic labels to modify

#'   according to the control specifications. Labels that are explicitly defined in `labels_custom` will

#'   not be affected.

#' @param labels_custom (named `character`)\cr named vector of labels that are customized by

#'   the user and should not be affected by `control`.

#' @param control (named `list`)\cr list of control parameters to apply to adjust default labels.

#'

#' @return A named character vector of labels with control specifications applied to relevant labels.

#'

#' @examples

#' control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57)

#' get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) %>%

#'   labels_use_control(control = control)

#'

#' @export

labels_use_control <- function(labels_default, control, labels_custom = NULL) {

        } else {

        }

      }

    )

  }

    )

  }

    )

  }

}

#' @describeIn default_stats_formats_labels Named list of available statistics by method group for `tern`.

#'

#' @format

#' * `tern_default_stats` is a named list of available statistics, with each element

#'   named for their corresponding statistical method group.

#'

#' @export

tern_default_stats <- list(

  abnormal = c("fraction"),

  abnormal_by_baseline = c("fraction"),

  abnormal_by_marked = c("count_fraction", "count_fraction_fixed_dp"),

  abnormal_by_worst_grade = c("count_fraction", "count_fraction_fixed_dp"),

  abnormal_by_worst_grade_worsen = c("fraction"),

  analyze_patients_exposure_in_cols = c("n_patients", "sum_exposure"),

  analyze_vars_counts = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  analyze_vars_numeric = c(

    "n", "sum", "mean", "sd", "se", "mean_sd", "mean_se", "mean_ci", "mean_sei", "mean_sdi", "mean_pval",

    "median", "mad", "median_ci", "quantiles", "iqr", "range", "min", "max", "median_range", "cv",

    "geom_mean", "geom_mean_ci", "geom_cv"

  ),

  count_cumulative = c("count_fraction", "count_fraction_fixed_dp"),

  count_missed_doses = c("n", "count_fraction", "count_fraction_fixed_dp"),

  count_occurrences = c("count", "count_fraction", "count_fraction_fixed_dp", "fraction"),

  count_occurrences_by_grade = c("count_fraction", "count_fraction_fixed_dp"),

  count_patients_with_event = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  count_patients_with_flags = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  count_values = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  coxph_pairwise = c("pvalue", "hr", "hr_ci", "n_tot", "n_tot_events"),

  estimate_incidence_rate = c("person_years", "n_events", "rate", "rate_ci"),

  estimate_multinomial_response = c("n_prop", "prop_ci"),

  estimate_odds_ratio = c("or_ci", "n_tot"),

  estimate_proportion = c("n_prop", "prop_ci"),

  estimate_proportion_diff = c("diff", "diff_ci"),

  summarize_ancova = c("n", "lsmean", "lsmean_diff", "lsmean_diff_ci", "pval"),

  summarize_coxreg = c("n", "hr", "ci", "pval", "pval_inter"),

  summarize_glm_count = c("n", "rate", "rate_ci", "rate_ratio", "rate_ratio_ci", "pval"),

  summarize_num_patients = c("unique", "nonunique", "unique_count"),

  summarize_patients_events_in_cols = c("unique", "all"),

  surv_time = c("median", "median_ci", "quantiles", "range_censor", "range_event", "range"),

  surv_timepoint = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "rate_diff", "rate_diff_ci", "ztest_pval"),

  tabulate_rsp_biomarkers = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"),

  tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval"),

  tabulate_survival_biomarkers = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"),

  tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval"),

  test_proportion_diff = c("pval")

)

#' @describeIn default_stats_formats_labels Named vector of default formats for `tern`.

#'

#' @format

#' * `tern_default_formats` is a named vector of available default formats, with each element

#'   named for their corresponding statistic.

#'

#' @export

tern_default_formats <- c(

  fraction = format_fraction_fixed_dp,

  unique = format_count_fraction_fixed_dp,

  nonunique = "xx",

  unique_count = "xx",

  n = "xx.",

  count = "xx.",

  count_fraction = format_count_fraction,

  count_fraction_fixed_dp = format_count_fraction_fixed_dp,

  n_blq = "xx.",

  sum = "xx.x",

  mean = "xx.x",

  sd = "xx.x",

  se = "xx.x",

  mean_sd = "xx.x (xx.x)",

  mean_se = "xx.x (xx.x)",

  mean_ci = "(xx.xx, xx.xx)",

  mean_sei = "(xx.xx, xx.xx)",

  mean_sdi = "(xx.xx, xx.xx)",

  mean_pval = "x.xxxx | (<0.0001)",

  median = "xx.x",

  mad = "xx.x",

  median_ci = "(xx.xx, xx.xx)",

  quantiles = "xx.x - xx.x",

  iqr = "xx.x",

  range = "xx.x - xx.x",

  min = "xx.x",

  max = "xx.x",

  median_range = "xx.x (xx.x - xx.x)",

  cv = "xx.x",

  geom_mean = "xx.x",

  geom_mean_ci = "(xx.xx, xx.xx)",

  geom_cv = "xx.x",

  pval = "x.xxxx | (<0.0001)",

  pval_counts = "x.xxxx | (<0.0001)",

  range_censor = "xx.x to xx.x",

  range_event = "xx.x to xx.x"

)

#' @describeIn default_stats_formats_labels Named `character` vector of default labels for `tern`.

#'

#' @format

#' * `tern_default_labels` is a named `character` vector of available default labels, with each element

#'   named for their corresponding statistic.

#'

#' @export

tern_default_labels <- c(

  fraction = "fraction",

  unique = "Number of patients with at least one event",

  nonunique = "Number of events",

  n = "n",

  count = "count",

  count_fraction = "count_fraction",

  count_fraction_fixed_dp = "count_fraction",

  n_blq = "n_blq",

  sum = "Sum",

  mean = "Mean",

  sd = "SD",

  se = "SE",

  mean_sd = "Mean (SD)",

  mean_se = "Mean (SE)",

  mean_ci = "Mean 95% CI",

  mean_sei = "Mean -/+ 1xSE",

  mean_sdi = "Mean -/+ 1xSD",

  mean_pval = "Mean p-value (H0: mean = 0)",

  median = "Median",

  mad = "Median Absolute Deviation",

  median_ci = "Median 95% CI",

  quantiles = "25% and 75%-ile",

  iqr = "IQR",

  range = "Min - Max",

  min = "Minimum",

  max = "Maximum",

  median_range = "Median (Min - Max)",

  cv = "CV (%)",

  geom_mean = "Geometric Mean",

  geom_mean_ci = "Geometric Mean 95% CI",

  geom_cv = "CV % Geometric Mean",

  pval = "p-value (t-test)", # Default for numeric

  pval_counts = "p-value (chi-squared test)" # Default for counts

)

# To deprecate ---------

#' @describeIn default_stats_formats_labels Quick function to retrieve default formats for summary statistics:

#'   [analyze_vars()] and [analyze_vars_in_cols()] principally.

#'

#' @param type (`string`)\cr `"numeric"` or `"counts"`.

#'

#' @return

#' * `summary_formats()` returns a named `vector` of default statistic formats for the given data type.

#'

#' @examples

#' summary_formats()

#' summary_formats(type = "counts", include_pval = TRUE)

#'

#' @export

summary_formats <- function(type = "numeric", include_pval = FALSE) {

}

#' @describeIn default_stats_formats_labels Quick function to retrieve default labels for summary statistics.

#'   Returns labels of descriptive statistics which are understood by `rtables`. Similar to `summary_formats`.

#'

#' @param include_pval (`flag`)\cr same as the `add_pval` argument in [get_stats()].

#'

#' @return

#' * `summary_labels` returns a named `vector` of default statistic labels for the given data type.

#'

#' @examples

#' summary_labels()

#' summary_labels(type = "counts", include_pval = TRUE)

#'

#' @export

summary_labels <- function(type = "numeric", include_pval = FALSE) {

}

#' Control functions for Kaplan-Meier plot annotation tables

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Auxiliary functions for controlling arguments for formatting the annotation tables that can be added to plots

#' generated via [g_km()].

#'

#' @param x (`proportion`)\cr x-coordinate for center of annotation table.

#' @param y (`proportion`)\cr y-coordinate for center of annotation table.

#' @param w (`proportion`)\cr relative width of the annotation table.

#' @param h (`proportion`)\cr relative height of the annotation table.

#' @param fill (`flag` or `character`)\cr whether the annotation table should have a background fill color.

#'   Can also be a color code to use as the background fill color. If `TRUE`, color code defaults to `"#00000020"`.

#'

#' @return A list of components with the same names as the arguments.

#'

#' @seealso [g_km()]

#'

#' @name control_annot

NULL

#' @describeIn control_annot Control function for formatting the median survival time annotation table. This annotation

#'   table can be added in [g_km()] by setting `annot_surv_med=TRUE`, and can be configured using the

#'   `control_surv_med_annot()` function by setting it as the `control_annot_surv_med` argument.

#'

#' @examples

#' control_surv_med_annot()

#'

#' @export

control_surv_med_annot <- function(x = 0.8, y = 0.85, w = 0.32, h = 0.16, fill = TRUE) {

}

#' @describeIn control_annot Control function for formatting the Cox-PH annotation table. This annotation table can be

#'   added in [g_km()] by setting `annot_coxph=TRUE`, and can be configured using the `control_coxph_annot()` function

#'   by setting it as the `control_annot_coxph` argument.

#'

#' @param ref_lbls (`flag`)\cr whether the reference group should be explicitly printed in labels for the

#'   annotation table. If `FALSE` (default), only comparison groups will be printed in the table labels.

#'

#' @examples

#' control_coxph_annot()

#'

#' @export

control_coxph_annot <- function(x = 0.29, y = 0.51, w = 0.4, h = 0.125, fill = TRUE, ref_lbls = FALSE) {

}

#' Helper function to calculate x-tick positions

#'

#' @description `r lifecycle::badge("stable")`

#'